home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / em3270.zip / EM3270.INC < prev    next >
Text File  |  1986-07-13  |  16KB  |  601 lines
  1. {  EM3270: Turbo Pascal routines for IBM 3270 emulation.  }
  2. {  Copyright 1984, 85, 86 Piedmont Specialty Software.    }
  3. {                                                         }
  4. {           Version 2.03 July, 1986                       }
  5. {                                                         }
  6. {  Distributed as "User supported software." Anyone       }
  7. {  finding these routines useful is requested to send     }
  8. {  $20.00 to:                                             }
  9. {                                                         }
  10. {          Piedmont Specialty Software                    }
  11. {          P. O. Box 6637                                 }
  12. {          Macon, GA  31208                               }
  13. {                                                         }
  14. {  This fee entitles you to unrestricted personal use     }
  15. {  of EM3270 and product updates when available.          }
  16. {                                                         }
  17. {  Commercial licenses are available. Contact PSS at the  }
  18. {  address above or call (912) 474-2318 for details.      }
  19. {                                                         }
  20. {  This software may be freely distributed as long as     }
  21. {  the accompanying documentation and demonstration       }
  22. {  program are included, as well as this notice.          }
  23.  
  24. Const
  25.   Modified         = 16;
  26.   Invisible        = 32;
  27.   Blinking         = 64;
  28.   Dim              = 128;
  29.  
  30. Type
  31.   FieldPtrs  = ^FieldRcd;
  32.   FieldRcd   = Record
  33.                  XPos           : Byte;
  34.                  YPos           : Byte;
  35.                  Attribute      : Byte;
  36.                  FieldLength    : Byte;
  37.                  FieldValue     : String[80]
  38.                End;
  39.   PtrArray   = Array[1..MaxFields] of FieldPtrs;
  40.   ScreenLine = String[80];
  41.   AID        = (Enter,Escape,F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,
  42.                 F11,F12,F13,F14,F15,F16,F17,F18,F19,F20,PA1,PA2,PA3);
  43.   CursInfo   = Record
  44.                  Field : Byte;
  45.                  Char  : Byte;
  46.                  X     : Byte;
  47.                  Y     : Byte;
  48.                End;
  49.  
  50. Var
  51.   ScreenField : PtrArray;
  52.   LastField   : Byte;
  53.   ColorScreen : Boolean;
  54.   Cursor      : CursInfo;
  55.   BrightBG,
  56.   BrightFG,
  57.   DimBG,
  58.   DimFG       : Byte;
  59.  
  60.     {***************************}
  61.     {*  Initialize everything  *}
  62.     {***************************}
  63.  
  64. Procedure InitScreen;
  65.  
  66. Type
  67.   RegRec = Record
  68.              AX,BX,CX,DX,BP,SI,DI,ES,Flags : Integer;
  69.            End;
  70.  
  71. Var
  72.   I : Integer;
  73.   Regs : RegRec;
  74.  
  75. Begin
  76. For I := 1 to MaxFields do ScreenField[I] := Nil;
  77. Intr ($11, Regs);
  78. Case Lo(Regs.AX) and $30 of
  79.   $10 : Begin
  80.         TextMode (C80);
  81.         ColorScreen := True;
  82.         End;
  83.   $20 : ColorScreen := True;
  84.   $30 : ColorScreen := False;
  85. Else
  86.   Begin
  87.   ClrScr;
  88.   WriteLn ('THIS PROGRAM MUST HAVE AN');
  89.   WriteLn ('80-COLUMN SCREEN, COLOR OR');
  90.   WriteLn ('MONOCHROME, TO RUN PROPERLY.'); WriteLn;
  91.   WriteLn ('USE THE COMMAND'); WriteLn;
  92.   WriteLn ('     MODE CO80     (color)');
  93.   WriteLn ('or');
  94.   WriteLn ('     MODE MONO     (mono)'); WriteLn;
  95.   WriteLn ('AND TRY THIS PROGRAM AGAIN.');
  96.   Halt;
  97.   End;
  98.   End; {of case}
  99. DimBG := Black; DimFG := LightGray;
  100. BrightBG := LightGray; BrightFG := Black;
  101. End;
  102.  
  103.     {*******************************************}
  104.     {*  Set video mode specified by attribute  *}
  105.     {*******************************************}
  106.  
  107. Procedure NormVid (At:Byte);
  108. Var I,J : Byte;
  109. Begin
  110. If (At and Blinking) <> 0 then I := 16 else I := 0;
  111. If ColorScreen Then
  112.   Begin
  113.   J := At and 15;
  114.   If J = 0 then J := BrightFG;
  115.   TextColor (J+I);
  116.   TextBackground (BrightBG);
  117.   End
  118. Else
  119.   Begin
  120.   TextColor (Black+I);
  121.   TextBackground (LightGray);
  122.   End;
  123. End;
  124.  
  125. Procedure LowVid (At:Byte);
  126. Var I,J : Byte;
  127. Begin
  128. If (At and Blinking) <> 0 then I := 16 else I := 0;
  129. If ColorScreen Then
  130.   Begin
  131.   J := At and 15;
  132.   If J = 0 then J := DimFG;
  133.   TextColor (J+I);
  134.   TextBackground (DimBG);
  135.   End
  136. Else
  137.   Begin
  138.   TextColor (LightGray+I);
  139.   TextBackground (Black);
  140.   End;
  141. End;
  142.  
  143. Procedure SetVid (At:Byte);
  144. Begin
  145. If (At and Dim) <> 0 then LowVid(At) else NormVid(At);
  146. End;
  147.  
  148.     {******************************}
  149.     {*  Adjust length of and pad  *}
  150.     {*  a string with blanks      *}
  151.     {******************************}
  152.  
  153. Procedure Adjust (Var Strng:ScreenLine; Lngth:Byte);
  154. Var I : Integer;
  155. Begin
  156. If Length(Strng) < Lngth Then
  157.   Begin
  158.   I := Length(Strng) + 1;
  159.   FillChar (Strng[I], 81-I, ' ');
  160.   End;
  161. Strng[0] := Chr(Lngth);
  162. End;
  163.  
  164.     {*******************************}
  165.     {*  Convert 3270 attribute to  *}
  166.     {*  PC hardware attribute      *}
  167.     {*******************************}
  168.  
  169. Procedure ConvAttr (Var InAt,OutAt:Byte);
  170. Var
  171.   I : Byte;
  172. Begin
  173. I := InAt and $0F;
  174. If (InAt and Dim) = 0 Then
  175.   If ColorScreen Then
  176.     Begin
  177.     If I = 0 then OutAt := BrightFG else OutAt := I;
  178.     OutAt := OutAt or (BrightBG and 7) shl 4;
  179.     End
  180.   Else
  181.     OutAt := $70
  182. Else
  183.   If ColorScreen Then
  184.     Begin
  185.     If I = 0 then OutAt := DimFG else OutAt := I;
  186.     OutAt := OutAt or (DimBG and 7) shl 4;
  187.     End
  188.   Else
  189.     OutAt := $07;
  190. If (InAt and Blinking) <> 0 then OutAt := OutAt + 128;
  191. End;
  192.  
  193.     {******************************}
  194.     {*  Prepare for a new screen  *}
  195.     {******************************}
  196.  
  197. Procedure NewScreen;
  198.  
  199. Var
  200.   I : Integer;
  201.  
  202. Begin
  203. LowVid(0);
  204. ClrScr;
  205. I := 1;
  206. While (I <= MaxFields) and (ScreenField[I] <> Nil) do
  207.   Begin
  208.   Dispose(ScreenField[I]);
  209.   ScreenField[I] := Nil;
  210.   I := I + 1;
  211.   End;
  212. LastField := 0;
  213. End;
  214.  
  215.     {***************************************}
  216.     {*  Write a string to the screen fast  *}
  217.     {***************************************}
  218.  
  219. Procedure PutLine (X,Y,Attr:byte; Var StringIn:ScreenLine);
  220. Begin
  221.    Inline($1E/$8A/$86/Y/$FE/$C8/$B3/$50/$F6/$E3/$2B/$DB/$8A/$9E/X/$FE/$CB/$03/
  222.           $C3/$03/$C0/$8B/$F8/$8A/$BE/Attr/$C4/$B6/StringIn/$2B/$C9/$26/$8A/
  223.           $0C/$A0/ColorScreen/$22/$C9/$74/$34/$20/$C0/$74/$21/$BA/$00/$B8/$8E/
  224.           $DA/$BA/$DA/$03/$46/$26/$8A/$1C/$EC/$A8/$01/$75/$FB/$FA/$EC/$A8/$01/
  225.           $74/$FB/$89/$1D/$47/$47/$E2/$EB/$2A/$C0/$74/$0F/$BA/$00/$B0/$8E/$DA/
  226.           $46/$26/$8A/$1C/$89/$1D/$47/$47/$E2/$F6/$1F);
  227. End;
  228.  
  229.     {****************************************}
  230.     {*  Write a prompt field to the screen  *}
  231.     {****************************************}
  232.  
  233. Procedure WritePrompt(X,Y,Attr,Lngth:Byte; Stringin:ScreenLine);
  234.  
  235. Var
  236.   I        : Byte;
  237.   Strng    : ScreenLine;
  238.   HdwAt    : Byte;
  239.  
  240. Begin
  241. Strng := Stringin;
  242. Adjust (Strng, Lngth);
  243. ConvAttr (Attr, HdwAt);
  244. PutLine (X, Y, HdwAt, Strng);
  245. End;
  246.  
  247.     {***********************************}
  248.     {*  Rewrite a field to the screen  *}
  249.     {***********************************}
  250.  
  251. Procedure RewriteField(FieldNo:Byte; Stringin:ScreenLine; Attr:Byte);
  252.  
  253. Var
  254.   I     : Byte;
  255.   Strng : ScreenLine;
  256.   HdwAt : Byte;
  257.   X, Y  : Byte;
  258.  
  259. Begin
  260. Strng := Stringin;
  261. With ScreenField[FieldNo]^ do
  262.   Begin
  263.   Adjust (Strng, FieldLength);
  264.   Attribute := Attr;
  265.   FieldValue := Strng;
  266.   X := XPos;
  267.   Y := YPos;
  268.   End;
  269. If (Attr and Invisible) <> 0 then FillChar (Strng[1], Length(Strng), ' ');
  270. ConvAttr (Attr, HdwAt);
  271. PutLine (X, Y, HdwAt, Strng);
  272. End;
  273.  
  274.     {******************************************}
  275.     {*  Write a new data field to the screen  *}
  276.     {******************************************}
  277.  
  278. Procedure WriteField(X,Y,Attr,Lngth:Byte; Stringin:ScreenLine);
  279.  
  280. Var
  281.   I                : Byte;
  282.   Strng            : ScreenLine;
  283.  
  284. Begin
  285. Strng := Stringin;
  286. Adjust (Strng, Lngth);
  287. LastField := LastField + 1;
  288. New(ScreenField[LastField]);
  289. With ScreenField[LastField]^ do
  290.   Begin
  291.   XPos := X;
  292.   YPos := Y;
  293.   FieldLength := Lngth;
  294.   End;
  295. RewriteField (LastField, Strng, Attr);
  296. End;
  297.  
  298.     {*****************************}
  299.     {*  Get input from keyboard  *}
  300.     {*****************************}
  301.  
  302. Procedure ReadScreen(FieldNo:Byte;Var FuncKey:AID);
  303.  
  304. Const
  305.   EntCd = #128;  EscCd = #129;
  306.  
  307.   F1Cd = #130;   F2Cd = #131;   F3Cd = #132;   F4Cd = #133;   F5Cd = #134;
  308.   F6Cd = #135;   F7Cd = #136;   F8Cd = #137;   F9Cd = #138;   F10Cd = #139;
  309.   F11Cd = #140;  F12Cd = #141;  F13Cd = #142;  F14Cd = #143;  F15Cd = #144;
  310.   F16Cd = #145;  F17Cd = #146;  F18Cd = #147;  F19Cd = #148;  F20Cd = #149;
  311.  
  312.   PA1Cd = #150;  PA2Cd = #151;  PA3Cd = #152;
  313.  
  314.   LeftArrow = #153;  RightArrow = #154;  Insert = #155;    Delete = #156;
  315.   EraseEOF = #157;   TabRight = #159;    TabLeft = #160;   NewLine = #161;
  316.   Home = #162;
  317.  
  318.     {*  Position the cursor  *}
  319.  
  320. Procedure PutCursorIn(FieldNo:Byte; Var X,Y:Byte);
  321.  
  322. Begin
  323. With ScreenField[FieldNo]^ do
  324.   Begin
  325.   X := XPos;
  326.   Y := YPos;
  327.   SetVid (Attribute);
  328.   End;
  329. GotoXY(X,Y);
  330. End;
  331.  
  332.     {*  Tab one field forward  *}
  333.  
  334. Procedure TabFwd(Var FieldNo:Byte);
  335.  
  336. Begin
  337. If FieldNo >= LastField Then
  338.   FieldNo := 1
  339. Else
  340.   FieldNo := FieldNo + 1;
  341. End;
  342.  
  343.     {*  Tab one field backward  *}
  344.  
  345. Procedure TabBack(Var FieldNo:Byte);
  346.  
  347. Begin
  348. If FieldNo = 1 Then
  349.   FieldNo := LastField
  350. Else
  351.   FieldNo := FieldNo - 1;
  352. End;
  353.  
  354.     {*  Tab one line down  *}
  355.  
  356. Procedure TabDown(Var FieldNo:Byte);
  357.  
  358. Var Y : Byte;
  359.  
  360. Begin
  361.   Y := ScreenField[FieldNo]^.YPos;
  362.   Repeat TabFwd(FieldNo) until (ScreenField[FieldNo]^.YPos<>Y) or (FieldNo=1);
  363. End;
  364.  
  365.     {*  Display a character  *}
  366.  
  367. Procedure DC(Ch:Char; At:Byte);
  368.  
  369. Begin
  370.   If (At and Invisible) = 0 Then Write(Ch) Else Write(' ');
  371. End;
  372.  
  373.     {*  Get a character from the keyboard *}
  374.  
  375. Procedure GetChar (Var Ch:Char);
  376.  
  377. Var
  378.   OK, Esc          : Boolean;
  379.  
  380. Begin
  381. Repeat
  382.   Esc := False;
  383.   Read (Kbd, Ch);
  384.   If Ch = #27 Then
  385.     Begin
  386.       Esc := True;
  387.       If KeyPressed then Read (Kbd, Ch);
  388.     End;
  389.   If (Esc) or (Ch < ' ') Then
  390.     Begin
  391.       OK := True;
  392.       Case Ch of
  393.         'K'      : Ch := LeftArrow;
  394.         'M'      : Ch := RightArrow;
  395.         'R'      : Ch := Insert;
  396.         'S'      : Ch := Delete;
  397.         ^I       : Ch := TabRight;
  398.         ^H,^O    : Ch := TabLeft;
  399.         #79      : Ch := EraseEOF;
  400.         'Q'      : Ch := NewLine;
  401.         'G'      : Ch := Home;
  402.         #27      : Ch := EscCd;
  403.         ^M       : Ch := EntCd;
  404.         ';'      : Ch := F1Cd;
  405.         '<'      : Ch := F2Cd;
  406.         '='      : Ch := F3Cd;
  407.         '>'      : Ch := F4Cd;
  408.         '?'      : Ch := F5Cd;
  409.         '@'      : Ch := F6Cd;
  410.         'A'      : Ch := F7Cd;
  411.         'B'      : Ch := F8Cd;
  412.         'C'      : Ch := F9Cd;
  413.         'D'      : Ch := F10Cd;
  414.         'h'      : Ch := F11Cd;
  415.         'i'      : Ch := F12Cd;
  416.         'j'      : Ch := F13Cd;
  417.         'k'      : Ch := F14Cd;
  418.         'l'      : Ch := F15Cd;
  419.         'm'      : Ch := F16Cd;
  420.         'n'      : Ch := F17Cd;
  421.         'o'      : Ch := F18Cd;
  422.         'p'      : Ch := F19Cd;
  423.         'q'      : Ch := F20Cd;
  424.         'x'      : Ch := PA1Cd;
  425.         'y'      : Ch := PA2Cd;
  426.         'z'      : Ch := PA3Cd;
  427.  
  428.       Else
  429.         OK := False;
  430.       End;
  431.     End
  432.   Else
  433.     If Ch in [ ' '..'~'] then OK := True else Ok := False;
  434. Until OK;
  435. End;
  436.  
  437. Var
  438.   X,Y,I,J,K,MDT   : Byte;
  439.   InsertMode,
  440.   InThisField     : Boolean;
  441.   InpChar         : Char;
  442.  
  443. Begin
  444. InsertMode := False;
  445. Repeat
  446.   PutCursorIn(FieldNo,X,Y);
  447.   InThisField := True;
  448.   MDT := 0;
  449.   I := 1;
  450.   J := FieldNo;
  451.   SetVid (ScreenField[FieldNo]^.Attribute);
  452.   While InThisField do
  453.     With ScreenField[FieldNo]^ do
  454.       Begin
  455.       GetChar (InpChar);
  456.       If InpChar in [' '..'~'] Then
  457.         Begin
  458.         If InsertMode Then
  459.           If (FieldValue[FieldLength] <> ' ') or (I = FieldLength) Then
  460.             Begin
  461.             Write(^G);
  462.             InpChar := #0;
  463.             End
  464.           Else
  465.             Begin
  466.             For K := FieldLength downto I+1 do
  467.               FieldValue[K] := FieldValue[K-1];
  468.             Write(' ');
  469.             For K := I+1 to FieldLength do DC(FieldValue[K], Attribute);
  470.             GotoXY(X,Y);
  471.             End;
  472.         If InpChar <> #0 Then
  473.           Begin
  474.           DC(InpChar, Attribute);
  475.           FieldValue[I] := InpChar;
  476.           MDT := Modified;
  477.           I := I + 1;
  478.           X := X + 1;
  479.           If I > FieldLength Then
  480.             Begin
  481.             TabFwd(FieldNo);
  482.             InThisField := False;
  483.             End;
  484.           End
  485.         End
  486.       Else
  487.         Case InpChar of
  488.  
  489.           RightArrow : Begin
  490.                        I := I + 1;
  491.                        X := X + 1;
  492.                        If I <= FieldLength Then
  493.                          GotoXY(X,Y)
  494.                        Else
  495.                          Begin
  496.                          TabFwd(FieldNo);
  497.                          InThisField := False;
  498.                          End;
  499.                       End;
  500.  
  501.           LeftArrow : Begin
  502.                       I := I - 1;
  503.                       X := X - 1;
  504.                       If I > 0 Then
  505.                         GotoXY(X,Y)
  506.                       Else
  507.                         Begin
  508.                         TabBack(FieldNo);
  509.                         InThisField := False;
  510.                         End;
  511.                       End;
  512.  
  513.  
  514.           TabRight  : Begin
  515.                       TabFwd(FieldNo);
  516.                       InThisField := False
  517.                       End;
  518.  
  519.           NewLine   : Begin
  520.                       TabDown(FieldNo);
  521.                       InThisField := False;
  522.                       End;
  523.  
  524.           TabLeft   : Begin
  525.                       TabBack(FieldNo);
  526.                       InThisField := False;
  527.                       End;
  528.  
  529.           Home     : Begin
  530.                      FieldNo := 1;
  531.                      InThisField := False;
  532.                      End;
  533.  
  534.           EraseEOF : Begin
  535.                      For K := I to FieldLength do
  536.                        Begin
  537.                        Write(' ');
  538.                        FieldValue[K] := ' ';
  539.                        End;
  540.                        GotoXY(X,Y);
  541.                      End;
  542.  
  543.           Delete    : Begin
  544.                       If I < FieldLength Then
  545.                         Begin
  546.                         For J := I to FieldLength - 1 do
  547.                           Begin
  548.                           FieldValue[J] := FieldValue[J+1];
  549.                           DC(FieldValue[J], Attribute);
  550.                           End;
  551.                         End;
  552.                       FieldValue[FieldLength] := ' ';
  553.                       Write(' ');
  554.                       GotoXY(X,Y);
  555.                       End;
  556.  
  557.           Insert    : Begin
  558.                       InsertMode := Not InsertMode;
  559.                       GotoXY(77,25);
  560.                       LowVid(0);
  561.                       If InsertMode Then Write('INS') Else Write('   ');
  562.                       GotoXY(X,Y);
  563.                       SetVid (Attribute);
  564.                       End;
  565.  
  566.           EntCd..PA3Cd : Begin
  567.                          InThisField := False;
  568.                          FuncKey := AID(Ord(InpChar) - 128);
  569.                          End;
  570.  
  571.           End; {of Case}
  572.       End;     {of With (and While)}
  573.   If MDT = Modified Then
  574.     With ScreenField[J]^ do Attribute := Attribute or MDT;
  575. Until InpChar in [EntCd..PA3Cd];   {end of Repeat}
  576. Cursor.Field := FieldNo;
  577. Cursor.Char := I;
  578. Cursor.X := X;
  579. Cursor.Y := Y;
  580. GotoXY (77,25);
  581. LowVid(0);
  582. Write ('   ');
  583. End;           {of Procedure ReadScreen}
  584.  
  585.     {**************************************}
  586.     {*  Get a field back from the screen  *}
  587.     {**************************************}
  588.  
  589. Procedure GetField(FieldNo:Byte; Var Strng:ScreenLine; Var Attr:Byte);
  590.  
  591. Var
  592.   I : Byte;
  593.  
  594. Begin
  595. With ScreenField[FieldNo]^ do
  596.   Begin
  597.   Attr := Attribute;
  598.   Strng := FieldValue;
  599.   End;
  600. End;
  601.